unit QBLinks;
{$I QBuilderVerCtrl.inc}
interface

uses
  {$IFDEF VCL16}
    Winapi.Windows,
    System.SysUtils,
    System.Classes,
    Vcl.Menus,
    Winapi.Messages,
  {$ELSE}
    Windows,
    SysUtils,
    Classes,
    Menus,
    Messages,
  {$ENDIF}
  QBParser,
  QBFloatPanel,
  QBFloatTable,
  QBStringTypes;

type

  TQBJoin = class(TObject)
  private
    FKind: TQBJoinKind;
    FTable1, FTable2: TQBTable;
    FParent: TQBWorkArea;
    function GetTable(Index: Integer): TQBTable;
  protected
    function GetTableName(Index: Integer): aqbString;
  public
    constructor CreateJoin(AParent: TQBWorkArea; Table1, Table2: TQBTable); virtual;
    property Parent: TQBWorkArea read FParent;
    property TableName[Index: Integer]: aqbString read GetTableName;
    property Table[Index: Integer]: TQBTable read GetTable;
    property Kind: TQBJoinKind read FKind write FKind;
  end;

  TQBLink = class(TQBFloatObject)
  private
    FJoin: TQBJoin;
    FCondition: aqbString;
    FField1, FField2: TQBListItem;
    FLeft, FRight, FTop, FBottom: Integer;
    FPoints: TList;
    FPointPopup: TPoint;
    FMovingPoint: Integer;
    FParent: TQBWorkArea;
    function GetLinkID: aqbString;
  protected
    function GetHint: aqbString; override;
    function GetBounds: TRect;
    procedure SetBounds(Value: TRect);
    function GetCountPoints: Integer;
    function GetPoint(Index: Integer): TPoint;
    procedure SetPoint(Index: Integer; Value: TPoint);
    function GetClipRgn(Mode: Integer): HRGN;
    procedure SetSelect(Value: Boolean); override;
    procedure HandleDeletePoint(Sender: TObject);
    procedure HandleInsertPoint(Sender: TObject);
    procedure HandleDeleteLink(Sender: TObject);
    procedure HandleLinkProperties(Sender: TObject);
  public
    constructor CreateLink(AParent: TQBWorkArea; AJoin: TQBJoin;
      Item1, Item2: TQBListItem); virtual;
    destructor Destroy; override;
    procedure Paint(DC: HDC); override;
    procedure Remove;
    function HitTest(Pt: TPoint): TTableHitTest; override;
    procedure MouseDown(var Msg: TWMMouse; Hit: TTableHitTest); override;
    procedure MouseMove(var Msg: TWMMouse; Hit: TTableHitTest); override;
    procedure MouseUp(var Msg: TWMMouse; Hit: TTableHitTest); override;
    procedure PopupMenu(var Menu: TPopupMenu; X, Y: Integer; Hit: TTableHitTest); override;
    function SetBoundaryRect: TRect;
    property Parent: TQBWorkArea read FParent;
    property Join: TQBJoin read FJoin;
    property CountPoints: Integer read GetCountPoints;
    property Points: TList read FPoints;
    property Point[Index: Integer]: TPoint read GetPoint write SetPoint;
    property BoundsRect: TRect read GetBounds write SetBounds;
    property Field1: TQBListItem read FField1;
    property Field2: TQBListItem read FField2;
    property Condition: aqbString read FCondition write FCondition;
    property ClipRgn[Mode: Integer]: HRGN read GetClipRgn;
    property LinkID: aqbString read GetLinkID;
  end;

function IsPointInPoly(ListPoints: TList; Point: TPoint): Bool;

implementation

uses 
  {$IFDEF VCL16}
    Vcl.Controls,
    Vcl.Forms,
  {$ELSE}
    Controls,
  {$ENDIF}
  {$IFDEF USE_DEVEXPRESS}
    QBDialogs,
    QBLinkProp_DEVEXP,
  {$ENDIF}
  {$IFNDEF USE_DEVEXPRESS}
    QBLinkProp,
  {$ENDIF}
  QBUtils,
  QBResource;

const
  FixLenth = 10;
  PI = 3.14159265;

  { External functions}

function IsPointInPoly(ListPoints: TList; Point: TPoint): Bool;
var
  CurPoint, NextPoint: TPoint;
  Pt: PPoint;
  Intersect, I, Next, Len, x: Integer;
begin
  Intersect := 0;
  Len := ListPoints.Count;
  for I := 0 to Len do
  begin
    Next := I + 1;
    if Next = Len + 1 then
      Next := 0;
    Pt := ListPoints.Items[I];
    CurPoint := Pt^;
    Pt := ListPoints.Items[Next];
    NextPoint := Pt^;
    if ((CurPoint.y >= Point.y) and (NextPoint.y <= Point.y)) or
      ((CurPoint.y <= Point.y) and (NextPoint.y >= Point.y)) then
      if CurPoint.x <= Point.x then
      begin
        if NextPoint.x <= Point.x then
          Inc(Intersect)
        else
        begin
          x := round((Point.y - CurPoint.y) * (NextPoint.x - CurPoint.x) /
            (NextPoint.y - CurPoint.y)) + CurPoint.x;
          if x <= Point.x then
            Inc(Intersect);
        end;
      end
      else if NextPoint.x <= Point.x then
      begin
        x := round((Point.y - NextPoint.y) * (CurPoint.x - NextPoint.x) /
          (CurPoint.y - NextPoint.y)) + NextPoint.x;
        if x <= Point.x then
          Inc(Intersect);
      end;
  end;
  if (Intersect mod 2) = 1 then
    Result := true
  else
    Result := false;
end;

{ TQBJoin }

constructor TQBJoin.CreateJoin(AParent: TQBWorkArea; Table1, Table2:
  TQBTable);
begin
  inherited Create;
  FParent := AParent;
  FTable1 := Table1;
  FTable2 := Table2;
  FKind := qbjInnerJoin;
end;

function TQBJoin.GetTable(Index: Integer): TQBTable;
begin
  if Index = 0 then
    Result := FTable1
  else if Index = 1 then
    Result := FTable2
  else
    Result := nil;
end;

function TQBJoin.GetTableName(Index: Integer): aqbString;
begin
  if Index = 0 then
    Result := FTable1.TableName
  else if Index = 1 then
    Result := FTable2.TableName
  else
    Result := '';
end;

{ TQBLink }

constructor TQBLink.CreateLink(AParent: TQBWorkArea; AJoin: TQBJoin;
  Item1, Item2: TQBListItem);
var
  Pt: ^TPoint;
begin
  inherited Create(AParent);
  FPoints := TList.Create;
  New(Pt);
  FPoints.Add(Pt);
  New(Pt);
  FPoints.Add(Pt);
  New(Pt);
  FPoints.Add(Pt);
  New(Pt);
  FPoints.Add(Pt);
  FParent := AParent;
  FJoin := AJoin;
  FField1 := Item1;
  FField2 := Item2;
  FCondition := '=';
  FMovingPoint := -1;
  SetBoundaryRect;
end;

destructor TQBLink.Destroy;
var
  I: Integer;
begin
  for I := 0 to CountPoints - 1 do
  begin
    Dispose(FPoints.Items[i]);
  end;
  FPoints.Free;
end;

function TQBLink.GetHint: aqbString;
begin
  Result := Join.FTable1.Alias + '.' + FField1.Caption +
    FCondition + Join.FTable2.Alias + '.' + FField2.Caption;
end;

function TQBLink.GetBounds: TRect;
begin
  Result.Left := FLeft;
  Result.Right := FRight;
  Result.Top := FTop;
  Result.Bottom := FBottom;
end;

procedure TQBLink.SetBounds(Value: TRect);
begin
  FLeft := Value.Left;
  FRight := Value.Right;
  FTop := Value.Top;
  FBottom := Value.Bottom;
end;

function TQBLink.GetCountPoints: Integer;
begin
  Result := FPoints.Count;
end;

function TQBLink.GetPoint(Index: Integer): TPoint;
var
  Pt: PPoint;
  xPos, yPos: Integer;
begin
  if (Index < 0) or (Index + 1 > CountPoints) then
    raise Exception.CreateFmt(rsLinksInvalidIndex, [Index]);

  {$IFDEF VCL16}
    xPos := (Parent as TScrollingWinControl).HorzScrollBar.Position;
    yPos := (Parent as TScrollingWinControl).VertScrollBar.Position;
  {$ELSE}
    xPos := (Parent as TWinControl).HorzScrollBar.Position;
    yPos := (Parent as TWinControl).VertScrollBar.Position;
  {$ENDIF}
  Pt := FPoints.Items[Index];
  Result.x := Pt^.x - xPos;
  Result.y := Pt^.y - yPos;
  //  Result:= FPoints.Items[Index];
end;

procedure TQBLink.SetPoint(Index: Integer; Value: TPoint);
var
  Pt: PPoint;
begin
  if (Index < 0) or (Index + 1 > CountPoints) then
    raise Exception.CreateFmt(rsLinksInvalidIndex, [Index]);
  Pt := FPoints.Items[Index];
  Pt^.x := Value.x;
  Pt^.y := Value.y;
end;

function TQBLink.GetClipRgn(Mode: Integer): HRGN;
var
  Pts: Pointer;
  P (*, Pt*): PPoint;
  Pt: TPoint;
  I, OldX, OldY, Scale, iStart, iEnd: Integer;
  TekRGN: HRGN;
begin
  GetMem(Pts, sizeof(TPoint) * 4);
  if (Mode = 0) or (Mode = 1) then
  begin
    Pt := Point[1]; //FPoints.Items[1];
    OldX := Pt.x;
    Pt := Point[0]; //FPoints.Items[0];
    if OldX > Pt.x then
      OldX := 1
    else
      OldX := -1;
    Result := CreateRectRgn(Pt.x - OldX, Pt.y - iArrowWidth - 1, Pt.x + OldX * (2
      * iArrowWidth + 1), Pt.y + iArrowWidth + 1);
    //    Result:=CreateRectRgn(Pt.x,Pt.y-LinkWidth,Pt.x+OldX*2*LinkWidth, Pt.y+LinkWidth);
  end
  else
    Result := CreateRectRgn(0, 0, 1, 1);
  iStart := 0;
  iEnd := FPoints.Count - 2;
  if Mode = 1 then
    iEnd := 1;
  if Mode = 2 then
    iStart := FPoints.Count - 3;
  for I := iStart to iEnd do
  begin
    P := Pts;
    Pt := Point[I]; //FPoints.Items[I];
    OldX := Pt.x;
    OldY := Pt.y;
    Pt := Point[I + 1]; //FPoints.Items[I+1];
    if (Pt.x - OldX <> 0) then
      Scale := (Pt.y - OldY) div (Pt.x - OldX)
    else
      Scale := 2;
    if Scale = 0 then
    begin
      P.x := OldX;
      P.y := OldY - 1;
      Inc(P, 1);
      P.x := Pt.x;
      P.y := Pt.y - 1;
      Inc(P, 1);
      P.x := Pt.x;
      P.y := Pt.y + 1;
      Inc(P, 1);
      P.x := OldX;
      P.y := OldY + 1;
    end
    else
    begin
      P.x := OldX - 1;
      P.y := OldY;
      Inc(P, 1);
      P.x := Pt.x - 1;
      P.y := Pt.y;
      Inc(P, 1);
      P.x := Pt.x + 1;
      P.y := Pt.y;
      Inc(P, 1);
      P.x := OldX + 1;
      P.y := OldY;
    end;
    TekRGN := CreatePolygonRgn(Pts^, 4, ALTERNATE);
    CombineRgn(Result, Result, TekRGN, RGN_OR);
    DeleteObject(TekRGN);
  end;
  for I := iStart + 1 to iEnd do
  begin
    Pt := Point[I];
    TekRGN := CreateRectRgn(Pt.x - iArrowWidth, Pt.y - iArrowWidth, Pt.x +
      iArrowWidth, Pt.y + iArrowWidth);
    CombineRgn(Result, Result, TekRGN, RGN_OR);
    DeleteObject(TekRGN);
  end;
  if (Mode = 0) or (Mode = 2) then
  begin
    Pt := Point[FPoints.Count - 2]; //FPoints.Items[FPoints.Count-2];
    OldX := Pt.x;
    Pt := Point[FPoints.Count - 1]; //FPoints.Items[FPoints.Count-1];
    if OldX > Pt.x then
      OldX := 1
    else
      OldX := -1;
    TekRGN := CreateRectRgn(Pt.x - OldX, Pt.y - iArrowWidth - 1, Pt.x + OldX * (2
      * iArrowWidth + 1), Pt.y + iArrowWidth + 1);
    //    TekRGN:=CreateRectRgn(Pt.x,Pt.y-LinkWidth,Pt.x+OldX*2*LinkWidth, Pt.y+LinkWidth);
    CombineRgn(Result, Result, TekRGN, RGN_OR);
    DeleteObject(TekRGN);
  end;
  FreeMem(Pts);
end;

procedure TQBLink.SetSelect(Value: Boolean);
var
  Rgn: HRGN;
  Rect: TRect;
  xPos, yPos: Integer;
begin
  inherited;
  FField1.Selected := Value;
  FField2.Selected := Value;
  (Parent as TQBWorkArea).SelectLink(FField1, FField2, Value);
  if Value then
  begin
    Rgn := ClipRgn[0];
    InvalidateRgn(Parent.Handle, Rgn, false);
    DeleteObject(Rgn);
  end
  else
  begin
    {$IFDEF VCL16}
      xPos := (Parent as TScrollingWinControl).HorzScrollBar.Position;
      yPos := (Parent as TScrollingWinControl).VertScrollBar.Position;
    {$ELSE}
      xPos := (Parent as TWinControl).HorzScrollBar.Position;
      yPos := (Parent as TWinControl).VertScrollBar.Position;
    {$ENDIF}
    Rect := BoundsRect;
    OffsetRect(Rect, -xPos, -yPos);
    InvalidateRect(Parent.Handle, @Rect, false);
    UpdateWindow(Parent.Handle);
  end;
end;

procedure TQBLink.HandleDeletePoint(Sender: TObject);
var
  I, xPos, yPos: Integer;
  Rgn: HRGN;
  Rect: TRect;
begin
  {$IFDEF VCL16}
    xPos := (Parent as TScrollingWinControl).HorzScrollBar.Position;
    yPos := (Parent as TScrollingWinControl).VertScrollBar.Position;
  {$ELSE}
    xPos := (Parent as TWinControl).HorzScrollBar.Position;
    yPos := (Parent as TWinControl).VertScrollBar.Position;
  {$ENDIF}
  for I := 2 to CountPoints - 3 do
  begin
    if (Abs(Point[I].x - FPointPopup.x) <= iLinkWidth) and
      (Abs(Point[I].y - FPointPopup.y) <= iLinkWidth) then
    begin
      Rect := BoundsRect;
      OffsetRect(Rect, -xPos, -yPos);
      InvalidateRect(Parent.Handle, @Rect, false);
      FPoints.Delete(I);
      Rgn := ClipRgn[0];
      InvalidateRgn(Parent.Handle, Rgn, false);
      DeleteObject(Rgn);
      Break;
    end;
  end;
end;

procedure TQBLink.HandleInsertPoint(Sender: TObject);
var
  I, xPos, yPos: Integer;
  Rgn: HRGN;
  pPt: PPoint;
begin
  {$IFDEF VCL16}
    xPos := (Parent as TScrollingWinControl).HorzScrollBar.Position;
    yPos := (Parent as TScrollingWinControl).VertScrollBar.Position;
  {$ELSE}
    xPos := (Parent as TWinControl).HorzScrollBar.Position;
    yPos := (Parent as TWinControl).VertScrollBar.Position;
  {$ENDIF}
  FPointPopup.x := FPointPopup.x + xPos;
  FPointPopup.y := FPointPopup.y + yPos;
  I := IsPointNearLine(Points, FPointPopup, CountPoints);
  if (I < 1) or (I + 3 > CountPoints) then
    Exit;
  New(pPt);
  pPt.x := FPointPopup.x;
  pPt.y := FPointPopup.y;
  Rgn := ClipRgn[0];
  InvalidateRgn(Parent.Handle, Rgn, false);
  DeleteObject(Rgn);
  FPoints.Insert(I + 1, pPt);
  Rgn := ClipRgn[0];
  InvalidateRgn(Parent.Handle, Rgn, false);
  DeleteObject(Rgn);
end;

procedure TQBLink.HandleDeleteLink(Sender: TObject);
var
  S: aqbString;
begin
  S := rsLinksWantDeleteLink + #13 + #10 +
    Join.TableName[0] + ' ' + rsLinkPropAnd + ' ' + Join.TableName[1];
{$IFNDEF USE_DEVEXPRESS}
  if MessageBox(Parent.Handle, PChar(S), PChar(rsLinksAttention), MB_YESNO or
    MB_ICONQUESTION) = IDNO then
    Exit;
{$ELSE}
  if not SMYesNoMsg(S) then
    Exit;
{$ENDIF}

  PostMessage(Parent.Handle, CM_DELETELINK, 0, Integer(Self));
end;

procedure TQBLink.HandleLinkProperties(Sender: TObject);
var
  Rgn: HRGN;
begin
  CurrentLnk := Self;
  if fmLinkProp.ShowModal = idOk then
  begin
    Rgn := ClipRgn[0];
    InvalidateRgn(Parent.Handle, Rgn, false);
    DeleteObject(Rgn);
  end;
end;

function TQBLink.SetBoundaryRect: TRect;
var
  Rect1, Rect2: TRect;
  p1, p2, p3, p4: TPoint;
  Pt: PPoint;
  I, EdgeX: Integer;
begin
  if Join.Table[0] = nil then
    raise Exception.CreateFmt(rsLinksInvalidTable, [Join.TableName[0]]);
  if Join.Table[1] = nil then
    raise Exception.CreateFmt(rsLinksInvalidTable, [Join.TableName[1]]);
  Rect1 := FField1.BoundsRect;
  Rect2 := FField2.BoundsRect;
  Pt := FPoints.Items[2];
  if CountPoints > 4 then
    EdgeX := Pt^.x
  else
    EdgeX := Rect2.Right;
  if Rect1.Left > EdgeX then
  begin
    p1.x := Rect1.Left;
    p2.x := Rect1.Left - FixLenth;
  end
  else
  begin
    p1.x := Rect1.Right;
    p2.x := Rect1.Right + FixLenth;
  end;
  Pt := FPoints.Items[CountPoints - 3];
  if CountPoints > 4 then
    EdgeX := Pt^.x
  else
    EdgeX := Rect1.Right;
  if Rect2.Left > EdgeX then
  begin
    p4.x := Rect2.Left;
    p3.x := Rect2.Left - FixLenth;
  end
  else
  begin
    p4.x := Rect2.Right;
    p3.x := Rect2.Right + FixLenth;
  end;

  p1.y := Rect1.Top + (Rect1.Bottom - Rect1.Top) div 2;
  p2.y := p1.y;
  p4.y := Rect2.Top + (Rect2.Bottom - Rect2.Top) div 2;
  p3.y := p4.y;
  Point[0] := p1;
  Point[1] := p2;
  Point[CountPoints - 2] := p3;
  Point[CountPoints - 1] := p4;
  Result.Left := MaxInt;
  Result.Top := MaxInt;
  Result.Right := 0;
  Result.Bottom := 0;
  for I := 0 to CountPoints - 1 do
  begin
    Pt := FPoints.Items[I];
    if Result.Left > Pt^.x then
      Result.Left := Pt^.x;
    if Result.Top > Pt^.y then
      Result.Top := Pt^.y;
    if Result.Right < Pt^.x then
      Result.Right := Pt^.x;
    if Result.Bottom < Pt^.y then
      Result.Bottom := Pt^.y;
  end;
  Result.Left := Result.Left - iLinkWidth;
  Result.Right := Result.Right + iLinkWidth;
  Result.Top := Result.Top - iLinkWidth;
  Result.Bottom := Result.Bottom + iLinkWidth;
  BoundsRect := Result;
end;

procedure TQBLink.MouseDown(var Msg: TWMMouse; Hit: TTableHitTest);
var
  I: Integer;
begin
  inherited;
  if Hit = htTPoint then
  begin
    for I := 2 to CountPoints - 3 do
      if (Abs(Point[I].x - Msg.XPos) <= iLinkWidth) and
        (Abs(Point[I].y - Msg.YPos) <= iLinkWidth) then
      begin
        FMovingPoint := I;
        FPointPopup.x := Point[I].x;
        FPointPopup.y := Point[I].y;
      end;
  end;
  if Hit = htTEndLine then
  begin
    if (Abs(Point[0].x - Msg.XPos) <= iLinkWidth) and
      (Abs(Point[0].y - Msg.YPos) <= iLinkWidth) then
      FMovingPoint := 0
    else
      FMovingPoint := CountPoints - 1;
  end;
end;

procedure TQBLink.MouseMove(var Msg: TWMMouse; Hit: TTableHitTest);
var
  MixMode: Integer;
  DC: HDC;
begin
  inherited;
  Parent.Cursor := crQBHand;
  if (Hit = htTPoint) and (MK_LBUTTON and Msg.Keys <> 0) then
  begin
    if (FMovingPoint > 1) and (FMovingPoint < CountPoints - 2) then
    begin
      DC := GetWindowDC(Parent.Handle);
      try
        MixMode := SetROP2(DC, R2_NOT);
        MoveToEx(DC, Point[FMovingPoint - 1].x, Point[FMovingPoint - 1].y, nil);
        LineTo(DC, FPointPopup.x, FPointPopup.y);
        LineTo(DC, Point[FMovingPoint + 1].x, Point[FMovingPoint + 1].y);
        FPointPopup.x := Msg.XPos;
        FPointPopup.y := Msg.YPos;
        LineTo(DC, Msg.XPos, Msg.YPos);
        LineTo(DC, Point[FMovingPoint - 1].x, Point[FMovingPoint - 1].y);
        SetROP2(DC, MixMode);
      finally
        ReleaseDC(Parent.Handle, DC);
      end;
    end;
  end;
  if (Hit = htTEndLine) and (MK_LBUTTON and Msg.Keys <> 0) then
  begin
    //    if FMovingPoint=0 then FSourceDrag:=FField2
  end;
end;

procedure TQBLink.MouseUp(var Msg: TWMMouse; Hit: TTableHitTest);
var
  xPos, yPos: Integer;
  Rgn: HRGN;
  Rect: TRect;
begin
  inherited;
  {$IFDEF VCL16}
    xPos := (Parent as TScrollingWinControl).HorzScrollBar.Position;
    yPos := (Parent as TScrollingWinControl).VertScrollBar.Position;
  {$ELSE}
    xPos := (Parent as TWinControl).HorzScrollBar.Position;
    yPos := (Parent as TWinControl).VertScrollBar.Position;
  {$ENDIF}
  if (FMovingPoint > 1) and (FMovingPoint < CountPoints - 2) then
  begin
    Rect := BoundsRect;
    OffsetRect(Rect, -xPos, -yPos);
    InvalidateRect(Parent.Handle, @Rect, false);
    FPointPopup.x := FPointPopup.x + xPos;
    FPointPopup.y := FPointPopup.y + yPos;
    Rect := BoundsRect;
    if FPointPopup.x - iLinkWidth < Rect.Left then
      Rect.Left := FPointPopup.x - iLinkWidth;
    if FPointPopup.x + iLinkWidth > Rect.Right then
      Rect.Right := FPointPopup.x + iLinkWidth;
    if FPointPopup.y - iLinkWidth < Rect.Top then
      Rect.Top := FPointPopup.y - iLinkWidth;
    if FPointPopup.y + iLinkWidth > Rect.Bottom then
      Rect.Bottom := FPointPopup.y + iLinkWidth;
    BoundsRect := Rect;
    Point[FMovingPoint] := FPointPopup;
    Rgn := ClipRgn[0];
    InvalidateRgn(Parent.Handle, Rgn, false);
    DeleteObject(Rgn);
    FMovingPoint := -1;
  end;
end;

procedure TQBLink.Paint(DC: HDC);
var
  SaveInd, I, PWidth1, PWidth2: Integer;
  PWidthArrow1, PWidthArrow2: Integer;
  PolyL, PolyR: array[0..2] of TPoint;
begin
  SaveInd := SaveDC(DC);
  if Selection then
    (Parent as TQBWorkArea).Pen.Width := 2
  else
    (Parent as TQBWorkArea).Pen.Width := 1; //Pen.Color:=clBlack;
  SelectObject(DC, (Parent as TQBWorkArea).Pen.Handle);

  if Point[0].x < Point[1].x then
  begin
    PWidth1 := 2 * iLinkWidth;
    PWidthArrow1 := 2 * iArrowWidth;
  end
  else
  begin
    PWidth1 := -2 * iLinkWidth;
    PWidthArrow1 := -2 * iArrowWidth;
  end;
  if Point[CountPoints - 2].x < Point[CountPoints - 1].x then
  begin
    PWidth2 := 2 * iLinkWidth;
    PWidthArrow2 := 2 * iArrowWidth;
  end
  else
  begin
    PWidth2 := -2 * iLinkWidth;
    PWidthArrow2 := -2 * iArrowWidth;
  end;
  if PWidth1 > 0 then
    MoveToEx(DC, Point[0].x, Point[0].y, nil)
  else
    MoveToEx(DC, Point[0].x - 1, Point[0].y, nil);
  for I := 1 to CountPoints - 1 do
  begin
    LineTo(DC, Point[I].x, Point[I].y);
    if (I > 1) and (I < CountPoints - 2) then
      Ellipse(DC, Point[I].x - iLinkWidth, Point[I].y - iLinkWidth, Point[I].x +
        iLinkWidth, Point[I].y + iLinkWidth);
  end;
  (Parent as TQBWorkArea).Pen.Width := 1;
  SelectObject(DC, (Parent as TQBWorkArea).Pen.Handle);

  PolyL[0].x := Point[0].x;
  PolyL[0].y := Point[0].y;
  PolyL[1].x := Point[0].x + PWidthArrow1;
  PolyL[1].y := Point[0].y - iArrowWidth;
  PolyL[2].x := Point[0].x + PWidthArrow1;
  PolyL[2].y := Point[0].y + iArrowWidth;
  PolyR[0].x := Point[CountPoints - 1].x;
  PolyR[0].y := Point[CountPoints - 1].y;
  PolyR[1].x := Point[CountPoints - 1].x - PWidthArrow2;
  PolyR[1].y := Point[CountPoints - 1].y - iArrowWidth;
  PolyR[2].x := Point[CountPoints - 1].x - PWidthArrow2;
  PolyR[2].y := Point[CountPoints - 1].y + iArrowWidth;

  case Join.Kind of
    qbjInnerJoin:
      begin
        Ellipse(DC, Point[0].x, Point[0].y - iLinkWidth, Point[0].x + PWidth1,
          Point[0].y + iLinkWidth);
        Ellipse(DC, Point[CountPoints - 1].x - PWidth2, Point[CountPoints - 1].y
          - iLinkWidth,
          Point[CountPoints - 1].x, Point[CountPoints - 1].y + iLinkWidth);
      end;
    qbjLOuterJoin:
      begin
        Polygon(DC, PolyL, 3);
        Ellipse(DC, Point[CountPoints - 1].x - PWidth2, Point[CountPoints - 1].y
          - iLinkWidth,
          Point[CountPoints - 1].x, Point[CountPoints - 1].y + iLinkWidth);
      end;
    qbjROuterJoin:
      begin
        Ellipse(DC, Point[0].x, Point[0].y - iLinkWidth, Point[0].x + PWidth1,
          Point[0].y + iLinkWidth);
        Polygon(DC, PolyR, 3);
      end;
    qbjFOuterJoin:
      begin
        Polygon(DC, PolyL, 3);
        Polygon(DC, PolyR, 3);
      end;
  end;
  RestoreDC(DC, SaveInd);
end;

function TQBLink.HitTest(Pt: TPoint): TTableHitTest;
var
  I, xPos, yPos: Integer;
begin
  Result := htTOutSide;
  {$IFDEF VCL16}
    xPos := (Parent as TScrollingWinControl).HorzScrollBar.Position;
    yPos := (Parent as TScrollingWinControl).VertScrollBar.Position;
  {$ELSE}
    xPos := (Parent as TWinControl).HorzScrollBar.Position;
    yPos := (Parent as TWinControl).VertScrollBar.Position;
  {$ENDIF}
  Pt.x := Pt.x + xPos;
  Pt.y := Pt.y + yPos;
  if IsPointNearLine(Points, Pt, CountPoints) <> -1 then
    Result := htTClient;
  Pt.x := Pt.x - xPos;
  Pt.y := Pt.y - yPos;
  for I := 0 to CountPoints - 1 do
  begin
    if (I = 1) or (I = CountPoints - 2) then
      Continue;
    if (Abs(Point[I].x - Pt.x) <= iLinkWidth) and
      (Abs(Point[I].y - Pt.y) <= iLinkWidth) then
      if (I = 0) or (I = CountPoints - 1) then
        Result := htTEndLine
      else
        Result := htTPoint;
  end;
end;

procedure TQBLink.PopupMenu(var Menu: TPopupMenu; X, Y: Integer; Hit:
  TTableHitTest);
var
  Item: TMenuItem;
begin
  if (Hit = htTPoint) or (Hit = htTClient) then
  begin
    FPointPopup.x := X;
    FPointPopup.y := Y;
    Item := TMenuItem.Create(Parent);
    if Hit = htTPoint then
    begin
      Item.Caption := rsLinksDeletePoint;
      Item.OnClick := HandleDeletePoint;
    end
    else
    begin
      Item.Caption := rsLinksInsertPoint;
      Item.OnClick := HandleInsertPoint;
    end;
    Menu.Items.Add(Item);
    Item := TMenuItem.Create(Parent);
    Item.Caption := '-';
    Menu.Items.Add(Item);
    Item := TMenuItem.Create(Parent);
    Item.Caption := rsLinksDeleteLink;
    Item.OnClick := HandleDeleteLink;
    Menu.Items.Add(Item);
    Item := TMenuItem.Create(Parent);
    Item.Caption := rsLinksProperty;
    Item.OnClick := HandleLinkProperties;
    Menu.Items.Add(Item);
  end;
end;

procedure TQBLink.Remove;
begin
  HandleDeleteLink(Self);
end;

function TQBLink.GetLinkID: aqbString;
begin
  Result := FField1.Table.TableName + '_' + FField1.Caption + '-' +
    FField2.Table.TableName + '_' + FField2.Caption;
end;

end.
